00100		SUBROUTINE TRNSP(IT,TR)
00200		COMMON /PX/KPN(1) /Q/Q(1) /XRN/RN(1) /STF/RFAC(1) /LLL/LEND
00300	CC	DIMENSION JSIG(14)
00400	CC	DATA JSIG/4,1,5,2,6,3,0,0,3,6,2,5,1,4/
00500	
00600		KSIG=99
00700		SIG=0
00750		NSIG=-1
00800		SLUR=0
00900		PRX=99
00910		MS=0
00920		TTR=AMOD(TR,7.0)
01000		K=1
01100		DO 47 L=1,IT
01200		J=KPN(L)
01300		X=Q(J+1)
01400		IF(X.EQ.17)GO TO 199
01500	C  FOUND KSIG, SO DON'T DO THE REST
01700		IF(X.EQ.3)MS=L
01800	C  REMEMBER WHERE CLEF IS
01900	47	IF(X.LT.3)GO TO 41
02000	C  LEAVE LOOP IF WE'VE GONE TOO FAR.
02050	41	IF(TTR.EQ.0)GO TO 199
02100		TYPE 42
02200	42	FORMAT(' ADD KEY SIG? -- ',$)
02300	43	FORMAT(A1)
02400		ACCEPT 43,X
02500		IF(X.NE.'Y')GO TO 199
02600	C  NEXT EXPANDS DATA.  PUT THIS IN FAIL LATER
02700		J=KPN(MS+1)
02800		L=KPN(IT)+7
02900		DO 45 N=L,J,-1
03000	45	Q(N+7)=Q(N)
03100		DO 46 N=IT+2,MS+1,-1
03200	46	KPN(N+1)=KPN(N)+7
03210		L=KPN(MS+1)
03220		Q(L)=4
03230		Q(L+1)=17
03240	CC  IT'S ALREADY 0 *****	Q(L+2)=0
03250		Q(L+3)=7*RFAC(9)
03260		Q(L+4)=0
03270		Q(L+5)=0
03280	C  THIS WILL BE CHANGED LATER.
03290		Q(L+6)=CLFNUM(Q,KPN,MS)
03295	C GETS THE CLEF NUM.
03300	CC	KPN(MS+1)=KPN(MS)+6
03400		IT=IT+1
03450		LEND=IT+1
03460		CALL EXPND(MS,0)
03470	C  2ND ARG IS DUMMY -- LINE IS SHIFTED TO RT.
03500	
03600	199	J=KPN(K)
03700		X=Q(J+1)
03800		IF(X.EQ.1)GO TO 1
03900		IF(X.NE.3)GO TO 2
04000		CLEF=Q(J+5)
04100		IF(Q(J).LT.3)CLEF=0
04200		IF(TR.NE.8)GO TO 100
04300		IF(CLEF.NE.0)Q(J+5)=0
04400		IF(CLEF.LT.100)GO TO 100
04500	CC	Q(J+1)=1089.
04600		CALL SHRNK(K,IT)
04700	C  MAKE IT INVISIBLE IF IT WAS MINI.
04800		CLEF=CLEF-100
04900		GO TO 199
05000	2	IF(X.NE.4)GO TO 20
05100		BAR=-1
05200		MS=1
05210		GO TO 100
05300	20	IF(X.NE.17)GO TO 12
05400	C  HOW ABOUT CHANGE TO NO SIG?  OK, CODE =99
05410		NSIG=0
05500	2000	ADD=2
05600		IF(TR.EQ.4)ADD=1
05700		IF(TR.EQ.2)ADD=-3
05800	C 4=F, 3=G, 2=A, -2=E FLAT
05900		IF(TR.EQ.-2)ADD=3
06000		IF(TR.EQ.3)ADD=-1
06050		IF(TTR.EQ.0)ADD=0
06100		R=0
06200		IF(X.EQ.17)R=Q(J+5)
06300		SIG=R
06400		R=ADD+R
06500		KSIG=R
06575	C  FOR LATER CHECKS
06600	C  TO USE IN IMPROVED ROUTINE
06700	C*******  ADD NO-YES SIG FEATURE *******
06800		IF(X.EQ.1)GO TO 1000
06900		Q(J+5)=R
07000		IF(R.NE.0)GO TO 399
07100		CALL SHRNK(K,IT)
07200		K=K-1
07300	CC	IF(ADD.EQ.0)Q(J+1)=1089.
07400	C  CHANGE CODE TO 99 IF NO SIG.(1089.=11.*99.)
07430	399	IF(CLEF.NE.1)GO TO 100
07445	C  ONLY FOR BASS CLEF KSIGS (FR. HORN, BASS CLAR)
07460		R=CLEF
07500		IF(TR.EQ.8)R=0
07550		Q(J+6)=R
07600		GO TO 100
07700	12	IF(X.EQ.5)GO TO 120
07800		IF(X.NE.6)GO TO 100
07900	120	RT=TR
08000		IF(RT.NE.8)GO TO 121
08100		IF(CLEF.EQ.1)RT=-4
08200	121	Q(J+4)=Q(J+4)+RT
08300		Q(J+5)=Q(J+5)+RT
08400		IF(X.EQ.5)SLUR=Q(J+6)
08500	C  SAVES RIGHT POS. OF SLUR
08600		GO TO 100
08700	C  FOR BEAMS AND SLURS
08800	
08900	1	IF(KSIG.EQ.99)GO TO 2000
09000	1000	RT=TR
09100		R=Q(J+4)
09200		RX=AMOD(R,100.0)
09300		RZ=AMOD(RX,7.0)
09400	C  THE NOTE NUM
09500		R5=Q(J+5)
09600		A=AMOD(R5,10.0)
09700	C  THE ACCI
09800		RN(MS)=A
09900		RN(MS+1)=RX
10000	C  SAVE FOR REPEATS
10100		MS=MS+2
10200		CHNAT=3
10300		IF(MS.LT.4)GO TO 205
10400		N=MS-3
10500	200	IF(RX.NE.RN(N))GO TO 201
10600		IF(A.EQ.0)GO TO 204
10700	C  NOW WE'VE FOUND THE SAME NOTE WITH NO ACCI IN SAME MEAS.
10800		IF(A.EQ.RN(N-1))GO TO 204
10900		GO TO 203
11000	204	IF(TR.NE.8)GO TO 4
11100		IF(CLEF.EQ.1)RT=RT-12
11200	C  FOR BSCLAR
11300		GO TO 4
11400	201	N=N-2
11500		IF(N.GT.0)GO TO 200
11600	205	IF(NSIG)CHNAT=0
11700	203	ADD=A
11800	C  THE CHANGE IN ACCI
11900		IF(PRX.NE.RX)GO TO 44
12000	C IF PREV ACCI AND NT ARE SAME, SKIP OVER.
12100		IF(A.NE.0)GO TO 44
12200	C NOW SAME NOTE, NO ACCI
12300		IF(ABS(SLUR-Q(J+3)).LT.3)GO TO 204
12400	C  FOUND CONNECTING TIE
12500	44	IF(NSIG)GO TO 440
12600		IF(A.EQ.0)GO TO 443
12700	C  ONLY CHECKS ON MOTES WITH NO ACCI
13600	
13700	440	IF(TR.NE.1)GO TO 5
13800	C  NEXT FOR B-FLAT TRANSPOSITIONS
13900	9	IF(RZ.EQ.0)GO TO 7
14000		IF(RZ.NE.3)GO TO 4
14100	C NOW FOUND A B OR E
14200	7	IF(A.EQ.0)GO TO 70
14300		IF(A.NE.3)GO TO 71
14400	C  CHNG NO ACCI OR NAT TO SHARP
14500	70	ADD=2
14600	71	IF(A.EQ.1)GO TO 30
14700	C  CHNG FLAT TO NAT.
14800		IF(A.NE.2)GO TO 3
14900	C  NEXT FOR B#, E#
15000		RT=RT+1
15100	C  MOVE IT UP A STEP
15200	30	ADD=CHNAT
15300	C  MAKE IT NAT. IF NEEDED
15400	3	Q(J+5)=R5-A+ADD
15500	4	PRX=RX
15600	40	Q(J+4)=R+RT
15700		BAR=0
15800		GO TO 100
15900	
15910	443	IF(CLEF.NE.1)GO TO 4
16000	5	IF(TR.NE.4)GO TO 6
16100	C FOUND "F" TRANS.
16200		IF(CLEF.EQ.1)GO TO 60
16300	C  MAKE ADJUSTMENT FOR BASS CLEF
16400	8	IF(RZ.EQ.0)GO TO 7
16500		GO TO 4
16600	
16700	6	IF(TR.NE.8)GO TO 10
16800	C NEXT FOR BSCLAR.---ADD OTHERS HERE!!!
16900		IF(CLEF.NE.1)GO TO 61
17000	60	RZ=RZ-5
17100		IF(RZ)RZ=RZ+7
17200		IF(TR.EQ.4)GO TO 8
17300		RT=RT-12
17400	61	IF(NSIG)GO TO 9
17420		IF(A.NE.0)GO TO 9
17450		GO TO 4
17500	10	IF(TR.NE.2)GO TO 11
17600		IF(RZ.EQ.1)GO TO 101
17700		IF(RZ.EQ.4)GO TO 101
17800		IF(RZ.NE.5)GO TO 4
17900	C  FOR "A".  FINDS C,F AND G.
18000	101	IF(A.EQ.0)GO TO 102
18100		IF(A.NE.3)GO TO 103
18200	C  FINDS NO ACCI OR NAT.
18300	102	ADD=1
18400	103	IF(A.EQ.2)GO TO 30
18500		GO TO 3
18600	11	IF(TR.NE.3)GO TO 110
18700		IF(RZ.NE.4)GO TO 4
18800		ADD=1
18900	C  "G"   F→Bb, F#→B NAT.
19000		IF(A.EQ.2)GO TO 30
19100	C  NOTHING FOR bb OR ## YET
19200		GO TO 3
19300	110	IF(TR.NE.-2)GO TO 4
19350	C  IF NOT -2 IT IS NOW THOUGHT TO BE SOME OCTAVE SHIFT.
19400		IF(RZ.EQ.3)GO TO 111
19500		IF(RZ.EQ.0)GO TO 111
19600		IF(RZ.NE.6)GO TO 4
19700	111	IF(A.EQ.0)GO TO 112
19800		IF(A.NE.3)GO TO 113
19900	112	ADD=2
20000	113	IF(A.EQ.1)GO TO 30
20100	C  FOR Eb TRNS
20200		GO TO 3
20300	100	IF(K.GE.IT)GO TO 299
20400		K=K+1
20500		GO TO 199
20600	299	CALL RVRS(IT)
20700	C  TO REVERSE STEMS, BEAMS AND SLURS
20800		END